home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
ICON_UTL
/
STOP
/
STOPLITE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-17
|
6KB
|
205 lines
program StopLight;
{
Program: STOPLITE.PAS
Version: 1.0
Creation Date: June 18, 1992
Modification Date: June 18, 1992
Operating System: MS-DOS 3.x and Windows 3.x
Hardware Required: Windows-capable computer system
Programming System: Turbo Pascal for Windows 1.0
Author: Craig Boyd
Ownership: Released to the public domain
About This Program
Demonstration program showing how to use the wm_timer message
to animate an icon.
Update History
update ver description (author)
------- --- -----------
9206.18 1.0 Released to public domain. (CSB)
}
uses
Strings,
WinTypes,
WinProcs,
WObjects,
Win31; { <-- omit if you are using TPW under Windows 3.0 }
{$R STOPLITE.RES}
{-- Global Declarations -------------------------------------------------}
const
AppName : pchar = 'Stoplight';
AppTitle : pchar = 'Stoplight';
GreenLite = 200; { icon id numbers }
YellowLite = 201;
RedLite = 202;
type
TStoplightApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
PMyWindow = ^TStoplightWindow;
TStoplightWindow = object(TWindow)
Counter : byte; { counts passes thru the WMTimer method }
Red, { icon handles }
Yellow,
Green : hicon;
destructor Done; virtual;
procedure SetupWindow; virtual;
function GetClassName : pchar; virtual;
procedure GetWindowClass(var WndClass : tWndClass); virtual;
procedure WMQueryOpen(var Msg : TMessage);
virtual wm_First + wm_QueryOpen;
procedure WMTimer(var Msg : TMessage);
virtual wm_First + wm_Timer;
end;
{-- TStoplightWindow Methods --------------------------------------------}
destructor TStoplightWindow.Done;
begin
{
Always kill the timer when you're done with it.
}
KillTimer(HWindow,1);
TWindow.Done;
end { TStoplightWindow.Done };
procedure TStoplightWindow.SetupWindow;
var
SysMenu : hMenu;
begin
TWindow.SetupWindow;
{
Remove unwanted system menu options. Note: It seems that
removing the sc_Restore menu option is enough to prevent
an icon from being opened; the override of wm_QueryOpen
may be redundant.
}
SysMenu := GetSystemMenu(hWindow,false);
DeleteMenu(SysMenu,sc_Restore,mf_ByCommand);
DeleteMenu(SysMenu,sc_Size,mf_ByCommand);
DeleteMenu(SysMenu,sc_Minimize,mf_ByCommand);
DeleteMenu(SysMenu,sc_Maximize,mf_ByCommand);
{
Reset our timer pass counter.
}
Counter := 0;
{
Start a two-second timer.
Complain and exit if none are available.
}
if SetTimer(HWindow,1,2000,nil) = 0 then begin
MessageBeep(0);
MessageBox(HWindow,'No free timers','Error',mb_OK or mb_IconExclamation);
halt(1);
end;
end { TStoplightWindow.SetupWindow };
function TStoplightWindow.GetClassName;
begin
GetClassName := AppName;
end { TStoplightWindow.GetClassName };
procedure TStoplightWindow.GetWindowClass;
begin
TWindow.GetWindowClass(WndClass);
{
Load the three traffic light icon resources.
}
Red := LoadIcon(HInstance,pchar(RedLite));
Yellow := LoadIcon(HInstance,pchar(YellowLite));
Green := LoadIcon(HInstance,pchar(GreenLite));
{
We'll start with the green light.
}
WndClass.hIcon := Green;
end { TStoplightWindow.GetWindowClass };
procedure TStoplightWindow.WMQueryOpen;
{
Override requests to open the window.
}
begin
Msg.Result := 0;
end { TStoplightWindow.WMQueryOpen };
procedure TStoplightWindow.WMTimer;
{
Here's where all the work is done. This method handles the timer
messages, which are sent at two-second intervals. We want the visible
icon to cycle from green to yellow to red, then start all over again.
We use a counter to determine which icon to display. When this method
is called, it checks the value of the counter and responds as shown
in the following table...
Value Response
----- --------
0 Load and display green light icon.
1 Do nothing.
2 Load and display yellow light icon.
3 Load and display red light icon.
4 Do nothing.
5 Reset the counter.
In other words, we display the green light for 4 seconds, the yellow
light for 2 seconds, the red light for four seconds, then start all
over again.
By adjusting the timer frequency (in TStoplightWindow.SetupWindow) and
the counter step values, you can simulate the traffic light cycle of
your favorite intersection!
}
begin
inc(Counter);
if Counter > 4 then Counter := 0;
{
Update TStoplightWindow's icon handle, based on the counter value.
}
case Counter of
0 : SetClassWord(HWindow,gcw_HIcon,Green);
2 : SetClassWord(HWindow,gcw_HIcon,Yellow);
3 : SetClassWord(HWindow,gcw_HIcon,Red);
else
exit;
end;
{
Force the new icon to be displayed.
}
InvalidateRect(HWindow,nil,true);
end { TStoplightWindow.WMTimer };
{-- TStoplightApp Methods -----------------------------------------------}
procedure TStoplightApp.InitMainWindow;
begin
MainWindow := New(PMyWindow,Init(nil,AppTitle));
end { TStoplightApp.InitMainWindow };
{-- Main Program --------------------------------------------------------}
var
StoplightApp : TStoplightApp;
begin
{
We want our app to start out minimized.
}
CmdShow := sw_ShowMinimized;
StoplightApp.Init(AppName);
StoplightApp.Run;
StoplightApp.Done;
end.